perm filename CRE.LSP[CRE,BGB]1 blob
sn#043263 filedate 1973-05-17 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 (SETQ IBASE (ADD1 7))
00005 00003 (DEFPROP INCRE
00006 00004 (DE CW(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A)))(QUOTE FIXNUM)))
00008 ENDMK
⊗;
(SETQ IBASE (ADD1 7))
(DEFPROP RJ(LAMBDA(L)
(COND ((GREATERP (LENGTH L) 2) L) (T (RJ (CONS 0 L)))))
EXPR)
(DEFPROP LJ(LAMBDA(L)
(COND ((GREATERP (LENGTH L) 5) L) (T (LJ (APPEND L (QUOTE (0)))))))
EXPR)
(DEFPROP BINSIX(LAMBDA(NAME)
(MAPCAR(FUNCTION(LAMBDA(CHR)
(*PLUS(LSH(EXAMINE
(MAKNUM(CAR(GET CHR(QUOTE PNAME)))(QUOTE FIXNUM)))-35)-40)))
(EXPLODE NAME)))
EXPR)
(DEFPROP BINPAK(LAMBDA(I Z)
(COND((NULL Z)I)(T(BINPAK(BOOLE 7(LSH I 6)(CAR Z))(CDR Z)))))
EXPR)
(DEFPROP MKBINPUT(LAMBDA()(PROG()
(AND(GET(QUOTE BINPUT)(QUOTE SUBR))(RETURN()))
(SETQ BINFIL(PLUS 0 BPORG))
(SETQ BINEXT(PLUS 1 BPORG))
(SETQ BINDZM(PLUS 2 BPORG))
(SETQ BINPPN(PLUS 3 BPORG))
(SETQ BPORG (PLUS 3 BPORG))
(PUTPROP(QUOTE BINPUT)(NUMVAL(ADD1 BPORG))(QUOTE SUBR))
(MAPC(FUNCTION(LAMBDA(I)
(DEPOSIT(SETQ BPORG(ADD1 BPORG))I)))(QUOTE
(201140000003 -262537514640 260140000005 41340000017 -331425000000 0
254004000020 76344777771 254004000020 201241200000 -203633000004 275043000000
-224777777777 311040000002 254004000017 -277533000004 202244000023
56344000023 334000000000 -375777777777 71340000000 263600000000 0 0 0)))
))EXPR)
(DEFPROP BINMKF(LAMBDA(Q)(PROG()
(DEPOSIT BINFIL(BINPAK 0(LJ(BINSIX(CAR Q)))))
(DEPOSIT BINEXT(BINPAK 0(LJ(BINSIX @CRE))))
(DEPOSIT BINDZM 0)
(DEPOSIT BINPPN(COND((NULL(CDR Q))0)
((NULL(CDDR Q))(BINPAK 0(LJ(RJ(BINSIX(CADR Q))))))
(T(BINPAK 0(APPEND(RJ(BINSIX(CADR Q)))(RJ(BINSIX(CADDR Q)))))))))
)EXPR)
(DEFPROP INCRE
(LAMBDA(Q)
(PROG NIL
(MKBINPUT)(BINMKF Q)(SETQ BEGCRE BPORG)
(SETQ ENDCRE (BINPUT BPORG BPEND))
(AND(NULL ENDCRE)
(RETURN (PROG2 (PRINT @"CRE FILE NOT FOUND") NIL)))
(AND (GREATERP ENDCRE BPEND)
(RETURN (PROG2(TERPRI)NIL(PRINC @"CRE FILE REQUIRES ")
(PRINC(DIFFERENCE ENDCRE BPEND))
(PRINC @" MORE WORDS OF BINARY PROGRAM SPACE."))))
(SETQ BPORG ENDCRE)
(RETURN T)))
FEXPR)
(DE CW(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A)))(QUOTE FIXNUM)))
(DE CCW(A)(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A)))(QUOTE FIXNUM)))
(DE DAD(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 1)))(QUOTE FIXNUM)))
(DE SON(A)(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A 1)))(QUOTE FIXNUM)))
(DE ENDO(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 3)))(QUOTE FIXNUM)))
(DE EXO(A)(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A 3)))(QUOTE FIXNUM)))
(DE ALT(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 4)))(QUOTE FIXNUM)))
(DE NGON(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 5)))(QUOTE FIXNUM)))
(DE PGON(A)(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A 5)))(QUOTE FIXNUM)))
(DE NTIME(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 6)))(QUOTE FIXNUM)))
(DE PTIME(A)(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A 6)))(QUOTE FIXNUM)))
(DE CRETYPE(A)(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 2)))(QUOTE FIXNUM)))
(DE RELOC(A)(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A 2)))(QUOTE FIXNUM)))
(DE ROW(A)(QUOTIENT(MAKNUM(CAR(NUMVAL(PLUS BEGCRE A 3)))(QUOTE FIXNUM))64.0))
(DE COL(A)(QUOTIENT(MAKNUM(CDR(NUMVAL(PLUS BEGCRE A 3)))(QUOTE FIXNUM))64.0))